{-# LANGUAGE RankNTypes,PatternGuards,NoMonomorphismRestriction,FlexibleInstances #-}
{-# LANGUAGE ViewPatterns,DeriveGeneric,BangPatterns,FlexibleContexts #-}



module ForwardIRSlice where

import SliceADT
import Utils

import Data.Map ( Map )
import qualified Data.Map as M
import Data.IntMap ( IntMap )
import qualified Data.IntMap as IM
import Data.IntSet ( IntSet )
import qualified Data.IntSet as IS
import Data.Maybe  
import Data.Monoid
import Data.List 

import LLVM.Analysis
      
--------------
---
getFwdSlices :: IntMap Value -> IntMap ValueIds -> Slices -> Slices
getFwdSlices valMap idepMap fwdSli =  M.mapWithKey mapF fwdSlices'
  where 
    mapF k !ls = foldl' (instLine k) IS.empty $ findVals valMap ls   -- to source lines
    
    fwdSlices' = IM.foldlWithKey' doInvert mempty idepMap
    doInvert !acc i !ls = 
      foldl' (\a v -> M.insertWith' IS.union v (IS.singleton i) a) acc (toVars ls)  
        
    toVars = concatMap refs . findVals valMap 
    
    instLine k !ls i = case valueContent' i of 
       InstructionC CallInst {callFunction = fv, callArguments = avs } ->
                 callLine k ls i fv (map fst avs)
       InstructionC InvokeInst {invokeFunction = fv, invokeArguments = avs } ->
                 callLine k ls i fv (map fst avs)
       InstructionC RetInst {retInstValue = Nothing } -> ls
       InstructionC RetInst {retInstValue = Just (valueContent -> ConstantC{})} -> ls
       InstructionC UnconditionalBranchInst { } -> ls 
       InstructionC UnreachableInst { } -> ls
       InstructionC FenceInst { } -> ls
       _    ->  IS.insert (valueUniqueId i) ls 
       
    callLine k !ls i fv args = case valueContent' fv of
       FunctionC f ->  fwdInsts      where 
         !argFrmls = zip args (functionParameters f)
         fwdInsts = foldl' (matchKey k) (IS.insert (valueUniqueId i) ls) argFrmls
         matchKey k !acc (arg,frml)
           | elem k (refs arg) = IS.union acc $ lkpSli (toVarName' frml) fwdSli
           | otherwise = acc             
       _  -> IS.insert (valueUniqueId i) ls
       
{-# INLINE getFwdSlices #-} 
        
 
